home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / UnderButton.tcl < prev    next >
Encoding:
Text File  |  2004-05-25  |  2.6 KB  |  74 lines

  1. ###############################################################################
  2. ###############################################################################
  3. ##                          UnderButton
  4. ###############################################################################
  5. ###############################################################################
  6. ## Manages creating buttons, plain, radio or check, with underscored letters.
  7. ###############################################################################
  8. ###############################################################################
  9. ## (c) 2003-2004 AndrΘs Garcφa Garcφa. fandom@retemail.es
  10. ## You may distribute the contents of this file under the terms of the LGPL v2
  11. ###############################################################################
  12. ###############################################################################
  13.  
  14. namespace eval underButton {
  15.  
  16. ###############################################################################
  17. # Create
  18. #    Creates the button and binds the key to it.
  19. #
  20. # Parameters
  21. #    path: path to of the button to create.
  22. #    args: Arguments to be passed to the button, the same as usual with one
  23. #          addition: buttontype, either 'button', 'radiobutton' or
  24. #          'checkbutton'.
  25. ###############################################################################
  26. proc UnderButton {path args} {
  27.  
  28.     set buttonArgs ""
  29.     foreach {option value} $args {
  30.         switch -exact -- $option {
  31.             -buttontype {
  32.                 set buttonType $value
  33.             }
  34.             default {
  35.                 lappend buttonArgs $option $value
  36.                 switch -exact -- $option {
  37.                     -text {
  38.                         set text $value
  39.                     }
  40.                     -textvariable {
  41.                         set tmp $value
  42.                         regsub {\(.*\)} $tmp {} tmp
  43.                         global $tmp
  44.                         set text [subst $$value]
  45.                     }
  46.                     -under {
  47.                         set index [subst $value]
  48.                     }
  49.                 }
  50.             }
  51.         }
  52.     }
  53.     eval $buttonType [list $path] $buttonArgs
  54.  
  55.     set parentWin [winfo toplevel $path]
  56.     if {$index!=-1} {
  57.         bind $parentWin <Alt-[string tolower [string index $text $index]]> "
  58.             focus [list $path]
  59.             [list $path] invoke
  60.             break
  61.         "
  62.         bind $parentWin <Alt-[string toupper [string index $text $index]]> "
  63.             focus [list $path]
  64.             [list $path] invoke
  65.             break
  66.         "
  67.     }
  68.     bind [list $path] <Button-1> "focus [list $path]"
  69.     
  70.     return $path
  71. }
  72.  
  73. }
  74.